﻿Imports System.Net.Sockets
Imports System.Net
Imports System.Text
Imports Newtonsoft.Json
Imports System.IO

Public Class Form1
    Private mUDP As Socket = Nothing

    Private mBind As Boolean
    Private mEncode As Text.Encoding
    ''' <summary>
    ''' 自动发送间隔
    ''' </summary>
    Private mAutoSendInterval As Integer
    ''' <summary>
    ''' 每轮自动发送周期中重复发送次数
    ''' </summary>
    Private mAutoSendTimes As Integer
    ''' <summary>
    ''' 自动发送的数据内容
    ''' </summary>
    Private mAutoSendBuf() As Byte

    Private mAutoSendServerEndPoint As IPEndPoint

    Private mShowLog As Boolean




    Private Sub ButBind_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButBind.Click
        If mBind Then
            '已绑定。停止绑定
            mUDP.Shutdown(SocketShutdown.Both)
            mUDP.Close()
            mUDP = Nothing

            ButBind.Text = "绑定"

            mBind = False

            SetEnabled(True)
        Else
            Dim lListenerPort As Long
            '开始监听

            If Not Long.TryParse(TxtPort.Text, lListenerPort) Then
                MsgBox("请输入正确的绑定端口号！", 64, "提示")
                Return
            End If

            Dim sIP As String = TxtServer.Text
            If RbMulticast.Checked Then
                If String.IsNullOrEmpty(sIP) Then
                    MsgBox("请输入组播IP！", 16, "错误")
                    Return
                End If
            End If

            '获取本地监听信息

            Dim ipdtl As IPDetial = TryCast(cmbLocalNetAddr.SelectedItem, IPDetial)
            Dim localEndPoint As IPEndPoint

            If ipdtl Is Nothing Then
                localEndPoint = New IPEndPoint(IPAddress.Any, lListenerPort) '创建一个绑定点
            Else
                Dim ipAddr As IPAddress = ipdtl.Addr

                localEndPoint = New IPEndPoint(ipAddr, lListenerPort) '创建一个绑定点
            End If



            '创建监听器
            mUDP = New Socket(localEndPoint.AddressFamily, SocketType.Dgram, ProtocolType.Udp)

            TxtServer.ReadOnly = True
            If RbUDP.Checked Then
                TxtServer.ReadOnly = False
            End If

            '检查是否为广播包
            Dim bOpt(100) As Byte
            If localEndPoint.AddressFamily = AddressFamily.InterNetwork And RbBroadcast.Checked Then
                mUDP.SetSocketOption(SocketOptionLevel.Socket, SocketOptionName.Broadcast, True)
                TxtServer.Text = "255.255.255.255"
            End If




            '将监听器绑定到本地IP的指定端口上
            Try
                mUDP.Bind(localEndPoint)
                Dim oIP As IPEndPoint = mUDP.LocalEndPoint
                Dim sTxt As String = String.Format("绑定本地端口：{0}", oIP.ToString)
                SetText(sTxt)
            Catch SocketEx As SocketException
                mUDP = Nothing
                MsgBox("端口绑定失败，可能被占用！" & vbNewLine & SocketEx.Message)
                Return
            Catch ex As Exception

            End Try




            If RbMulticast.Checked Then
                mUDP.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.MulticastTimeToLive, 1) 'IP 多路广播生存时间。
                Dim oIP As IPAddress
                oIP = IPAddress.Parse(sIP)
                mUDP.SetSocketOption(SocketOptionLevel.IP, SocketOptionName.AddMembership, New MulticastOption(oIP, IPAddress.Any))
            End If


            SetEnabled(False)

            Dim oBuff() As Byte
            ReDim oBuff(1024 * 8)

            Dim oSocketEvent As SocketAsyncEventArgs
            oSocketEvent = New SocketAsyncEventArgs()
            oSocketEvent.RemoteEndPoint = localEndPoint
            AddHandler oSocketEvent.Completed, AddressOf ReceiveCompleted
            oSocketEvent.SetBuffer(oBuff, 0, oBuff.Length)

            Call BeginReceive(oSocketEvent)
            mBind = True
            ButBind.Text = "关闭"
        End If
    End Sub

#Region "接收数据"


    ''' <summary>
    ''' 开始进入监听接收状态
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub BeginReceive(ByVal e As SocketAsyncEventArgs)
        If mUDP Is Nothing Then Return

        If Not mUDP.ReceiveFromAsync(e) Then
            processReceived(e)
        End If
    End Sub

    Public Sub ReceiveCompleted(ByVal sender As Object, ByVal e As System.Net.Sockets.SocketAsyncEventArgs)
        Select Case e.LastOperation
            Case SocketAsyncOperation.ReceiveFrom
                processReceived(e)
            Case Else
                SetText("ReceiveCompleted 返回异常值：" & SocketAsyncOperation.ReceiveFrom)
        End Select
    End Sub

    Private Sub processReceived(ByVal e As SocketAsyncEventArgs)
        If e.BytesTransferred > 0 And e.SocketError = SocketError.Success Then
            Dim sTxt As String = String.Empty
            Dim bBuf() As Byte
            bBuf = copyOfRange(e.Buffer, 0, e.BytesTransferred)
            If ChkHex.Checked Then
                sTxt = ByteToHex(bBuf)
            Else

                sTxt = mEncode.GetString(bBuf)
            End If

            sTxt = String.Format("{0}:{1}", e.RemoteEndPoint.ToString, sTxt)
            SetText(sTxt)
        End If

        Select Case e.SocketError
            Case SocketError.OperationAborted
                'Socket已关闭
                Return
        End Select
        BeginReceive(e) '继续等待接收

    End Sub
#End Region


#Region "发送数据"
    Private Sub ButSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButSend.Click
        Dim sIP As String = TxtServer.Text
        Dim iPort As Long = 0
        Dim sTxt As String = TxtSend.Text

        If Not CheckInput() Then
            Return
        End If
        Long.TryParse(TxtServerPort.Text, iPort)

        Dim oEndPoint = GetRemoteEndPoint(sIP, iPort)
        If oEndPoint Is Nothing Then Return
        sTxt = TxtSend.Text
        Dim oBuff() As Byte
        If ChkHex.Checked Then
            sTxt = sTxt.Replace(vbNewLine, String.Empty)
            sTxt = sTxt.Replace(" ", String.Empty)
            oBuff = HexToByte(sTxt)
        Else
            oBuff = mEncode.GetBytes(sTxt)
        End If

        'mUDP.SendTo(oBuff, oEndPoint)
        Dim oSocketEvent As SocketAsyncEventArgs
        oSocketEvent = New SocketAsyncEventArgs()
        oSocketEvent.RemoteEndPoint = oEndPoint
        oSocketEvent.SetBuffer(oBuff, 0, oBuff.Length)
        AddHandler oSocketEvent.Completed, AddressOf SendCompleted

        If Not mUDP.SendToAsync(oSocketEvent) Then
            SendCompleted(Nothing, oSocketEvent)
        End If

    End Sub

    Private Function GetRemoteEndPoint(ByVal sIP As String, ByVal iPort As Integer) As IPEndPoint
        Dim ipAddress As IPAddress = Nothing
        Try
            ipAddress = IPAddress.Parse(sIP) '摘取本机IP地址
        Catch ex As Exception
            Try
                Dim oDNSIP As IPHostEntry = Dns.GetHostEntry(sIP)
                If oDNSIP.AddressList.Length > 0 Then
                    '获取服务器节点
                    ipAddress = oDNSIP.AddressList(0)
                    SetText(sIP & " --  解析到IP：" & ipAddress.ToString)
                Else
                    MsgBox("没有解析到IP地址！", 16, "错误")

                    Return Nothing
                End If
            Catch ex1 As SocketException
                MsgBox("网路哦地址无效！", 16, "错误")
                Return Nothing
            End Try
        End Try

        Return New IPEndPoint(ipAddress, iPort) '创建一个绑定点
    End Function


    Public Sub SendCompleted(ByVal sender As Object, ByVal e As System.Net.Sockets.SocketAsyncEventArgs)
        Select Case e.LastOperation
            Case SocketAsyncOperation.SendTo
                Dim sTxt As String
                sTxt = String.Format(">发送数据：{0}:{1}", e.RemoteEndPoint.ToString, TxtSend.Text)
                SetText(sTxt)
            Case Else
                SetText("SendCompleted返回异常值：" & SocketAsyncOperation.ReceiveFrom)
        End Select
    End Sub
#End Region

#Region "输出操作"
    ''' <summary>
    ''' 设置输出窗口文本的委托
    ''' </summary>
    ''' <param name="text"></param>
    ''' <remarks></remarks>
    Delegate Sub SetDebugTextCallback(ByVal [text] As String)

    ''' <summary>
    ''' 设置输出窗口文本
    ''' </summary>
    ''' <param name="text"></param>
    ''' <remarks></remarks>
    Private Sub SetText(ByVal [text] As String)
        If Not mShowLog Then Return
        If Me.TxtDebug.InvokeRequired Then
            Dim d As New SetDebugTextCallback(AddressOf SetText)
            Me.Invoke(d, New Object() {[text]})
        Else
            Dim sTxt As String = Format(Date.Now, "HH:mm:ss.ffff") & "--" & [text] & vbNewLine & TxtDebug.Text
            If sTxt.Length > 5000 Then
                sTxt = sTxt.Substring(1, 3000)
            End If
            Me.TxtDebug.Text = sTxt
        End If

    End Sub


    Delegate Sub SetReadCountCallback(ByVal [text] As String)
    Private Sub SetReadCount(ByVal sText As String)
        If Me.TxtReadByteCount.InvokeRequired Then
            Dim d As New SetReadCountCallback(AddressOf SetReadCount)
            Me.Invoke(d, New Object() {sText})
        Else
            Me.TxtReadByteCount.Text = sText
        End If
    End Sub



    ''' <summary>
    ''' 输出接入的客户端信息
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <remarks></remarks>
    Private Sub DebugClient(ByRef oClient As EndPoint)
        Dim sText As String

        sText = "有客户端接入：IP：" & oClient.ToString
        SetText(sText)
    End Sub
#End Region

    Private Class IPDetial
        Public Addr As IPAddress

        Public Sub New(ip As IPAddress)
            Addr = ip
        End Sub
        Public Overrides Function ToString() As String
            Return Addr.ToString()
        End Function
    End Class


    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        mBind = False
        TxtPort.Text = 0


        ShowlocalIP()
        TxtServerPort.Text = 65535

        SetEnabled(True)
        mShowLog = chkShowLog.Checked

        cmbTextEncode.Items.Clear()
        cmbTextEncode.Items.Add("GB2312")
        cmbTextEncode.Items.Add("UTF-8")
        cmbTextEncode.Items.Add("ASCII")
        cmbTextEncode.SelectedIndex = 0
        mEncode = GB2312

        '获取本地网卡列表
        cmbLocalNetAddr.Items.Clear()
        cmbLocalNetAddr.Items.Add(New IPDetial(IPAddress.Parse("127.0.0.1")))
        cmbLocalNetAddr.Items.Add(New IPDetial(IPAddress.Parse("[::]")))
        Try
            '获取本地监听信息
            Dim ipHostInfo As IPHostEntry '获取本机IP地址
            TxtDebug.Text += "本机名称：" + Dns.GetHostName() + vbNewLine
            ipHostInfo = Dns.GetHostEntry(Dns.GetHostName())
            For Each oIP As IPAddress In ipHostInfo.AddressList
                Dim sIPInfo As String
                Dim sType As String
                If oIP.IsIPv6LinkLocal Then
                    sType = "IPV6 地址"
                Else
                    sType = "IPV4 地址"
                End If
                sIPInfo = String.Format("IP：{0},协议类型：{1}{2}", oIP.ToString(), sType, vbNewLine)
                cmbLocalNetAddr.Items.Add(New IPDetial(oIP))
                TxtDebug.Text += sIPInfo
            Next

        Catch ex As Exception
            TxtDebug.Text += $"获取本机IP地址表时发生错误！
{ex.ToString }"
            'Return
        End Try


        LoadLocalSetting()
    End Sub


    Private SettingFile As String = Path.Combine(Directory.GetCurrentDirectory(), "setting.Json")
    Private Sub LoadLocalSetting()
        If Not File.Exists(SettingFile) Then Return
        Dim sConfJson = File.ReadAllText(SettingFile, Encoding.UTF8)
        Dim config = JsonConvert.DeserializeObject(Of LocalConfig)(sConfJson)
        TxtPort.Text = config.LocalPort
        TxtServer.Text = config.ServerAddr
        TxtServerPort.Text = config.ServerPort
        TxtSend.Text = config.SendText
        cmbTextEncode.SelectedItem = config.TextEncode
        ChkHex.Checked = config.IsHex
        For Each ip As IPDetial In cmbLocalNetAddr.Items
            If ip.ToString().Equals(config.LocalIP) Then
                cmbLocalNetAddr.SelectedItem = ip
                Exit For
            End If
        Next

        If Not String.IsNullOrEmpty(config.AutoSendInterval) Then
            txtAutoSendInterval.Text = config.AutoSendInterval
            txtAutoSendTimes.Text = config.AutoSendTimes
            chkShowLog.Checked = config.ShowLog
        End If

    End Sub


    Private Sub SaveLocalSetting()

        Dim config = New LocalConfig()
        config.LocalPort = TxtPort.Text
        config.ServerAddr = TxtServer.Text
        config.ServerPort = TxtServerPort.Text
        config.SendText = TxtSend.Text
        config.TextEncode = cmbTextEncode.SelectedItem
        config.IsHex = ChkHex.Checked
        config.AutoSendInterval = txtAutoSendInterval.Text
        config.AutoSendTimes = txtAutoSendTimes.Text
        config.ShowLog = chkShowLog.Checked
        If cmbLocalNetAddr.SelectedItem IsNot Nothing Then
            config.LocalIP = cmbLocalNetAddr.SelectedItem.ToString()
        End If

        Dim sConfJson = JsonConvert.SerializeObject(config, Formatting.Indented)
        File.WriteAllText(SettingFile, sConfJson, Encoding.UTF8)
    End Sub

    Private Sub Form1_FormClosed(sender As Object, e As FormClosedEventArgs) Handles Me.FormClosed
        If mBind Then
            mBind = False
        End If
        Try
            SaveLocalSetting()

            tmrAutoSend.Enabled = False
            If mUDP Is Nothing Then Return
            If mUDP.IsBound Then
                mUDP.Shutdown(SocketShutdown.Both)
                mUDP.Close()
            End If
        Catch ex As Exception
            MsgBox(ex.ToString())
        End Try



    End Sub


    Private Sub butClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butClear.Click
        TxtDebug.Text = String.Empty
    End Sub

    Private Sub RbMulticast_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RbMulticast.CheckedChanged
        TxtServer.Text = "234.56.78.9"
    End Sub

    Private Sub RbBroadcast_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RbBroadcast.CheckedChanged
        TxtServer.Text = "255.255.255.255"
    End Sub

    Private Sub RbUDP_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RbUDP.CheckedChanged
        ShowlocalIP()
    End Sub

    Private Sub ShowlocalIP()
        Dim ipHostInfo As IPHostEntry = Dns.GetHostEntry(Dns.GetHostName()) '获取本机IP地址
        TxtServer.Text = ipHostInfo.AddressList(0).ToString
    End Sub

    Private Sub SetEnabled(ByVal bValue As Boolean)
        RbUDP.Enabled = bValue
        RbBroadcast.Enabled = bValue
        RbMulticast.Enabled = bValue
        TxtPort.ReadOnly = Not bValue

        TxtServerPort.ReadOnly = bValue
        ButSend.Enabled = Not bValue

    End Sub


    Private mSendDataLen As Long
    Private mSendDataDate As Date

    Private Function CheckInput() As Boolean
        Dim sIP As String = TxtServer.Text
        Dim iPort As Long = 0
        Dim sTxt As String = TxtSend.Text

        If String.IsNullOrEmpty(sIP) Then
            MsgBox("目标IP地址错误！", 16, "错误")
            Return False
        End If

        If Not Long.TryParse(TxtServerPort.Text, iPort) Then
            MsgBox("请输入正确的目标端口号！", 64, "提示")
            Return False
        End If

        If Not mBind Then
            MsgBox("请首先绑定端口！", 16, "错误")
            Return False
        End If

        sTxt = TxtSend.Text
        If String.IsNullOrEmpty(sTxt) Then
            MsgBox("请输入需要发送的数据！", 16, "错误")
            Return False
        End If

        If ChkHex.Checked Then
            sTxt = sTxt.Replace(vbNewLine, String.Empty)
            sTxt = sTxt.Replace(" ", String.Empty)
            If Not CheckIsHex(sTxt) Then
                MsgBox("输入的内容不是十六进制字符串！", 16, "错误")
                Return False
            End If
        End If


        Return True
    End Function

    Private Sub btnAutoSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAutoSend.Click
        Dim sIP As String = TxtServer.Text
        Dim iPort As Long = 0

        If Not CheckInput() Then
            Return
        End If
        Long.TryParse(TxtServerPort.Text, iPort)

        mAutoSendServerEndPoint = GetRemoteEndPoint(sIP, iPort)
        If mAutoSendServerEndPoint Is Nothing Then Return

        Try
            mAutoSendInterval = CInt(txtAutoSendInterval.Text)
            mAutoSendTimes = CInt(txtAutoSendTimes.Text)
        Catch ex As Exception
            MsgBox("自动发送参数错误！", 16, "错误")
            Return
        End Try

        GetSendBuf()



        mSending = False
        mSendDataLen = 0
        TxtSendData.Text = mSendDataLen
        mSendDataDate = Now

        tmrAutoSend.Enabled = True
        tmrAutoSend.Interval = mAutoSendInterval
        btnAutoSend.Enabled = False
    End Sub

    Private Sub GetSendBuf()
        Dim sTxt = TxtSend.Text
        If String.IsNullOrEmpty(sTxt) Then
            Return
        End If
        If ChkHex.Checked Then
            mAutoSendBuf = HexToByte(sTxt)
        Else
            mAutoSendBuf = mEncode.GetBytes(sTxt)
        End If
    End Sub



    Dim mSending As Boolean
    Dim mSendCount As Integer

    Private Sub cmbTextEncode_SelectedIndexChanged(sender As Object, e As EventArgs) Handles cmbTextEncode.SelectedIndexChanged

        Select Case cmbTextEncode.Text
            Case "GB2312"
                mEncode = GB2312
            Case "UTF-8"
                mEncode = UTF8
            Case "ASCII"
                mEncode = ASCII
            Case Else
                mEncode = GB2312
        End Select

    End Sub

    Private Async Sub tmrAutoSend_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles tmrAutoSend.Tick

        Dim sTxt As String = TxtSend.Text
        Dim funcStop = Sub()
                           tmrAutoSend.Enabled = False
                           btnAutoSend.Enabled = True
                           mSending = False
                           mAutoSendServerEndPoint = Nothing
                       End Sub
        If Not mBind Then
            funcStop()
            Return
        End If
        If mAutoSendServerEndPoint Is Nothing Then
            funcStop()
            Return
        End If


        If mSending Then Return
        Me.Invoke(Sub()
                      GetSendBuf()
                  End Sub)
        Dim sendBuf As ArraySegment(Of Byte) = New ArraySegment(Of Byte)(mAutoSendBuf)


        Try

            mSendCount = 0
            mSending = True


            For i = 1 To mAutoSendTimes
                Await mUDP.SendToAsync(sendBuf, SocketFlags.None, mAutoSendServerEndPoint)
                mSendDataLen = mSendDataLen + sendBuf.Count

                If (Date.Now - mSendDataDate).Seconds >= 1 Then
                    SyncLock Me
                        Me.Invoke(Sub()
                                      If (Date.Now - mSendDataDate).Seconds >= 1 Then
                                          mSendDataDate = Now
                                          TxtSendData.Text = (mSendDataLen \ 1024) & "KB/s"
                                          mSendDataLen = 0
                                      End If
                                  End Sub)
                    End SyncLock
                End If

            Next
            mSending = False
        Catch ex As Exception
            mSending = False

            SetText("准备发送数据时出现错误：" & ex.Message)
        End Try
    End Sub


    Private Sub chkShowLog_CheckedChanged(sender As Object, e As EventArgs) Handles chkShowLog.CheckedChanged
        mShowLog = chkShowLog.Checked
    End Sub
End Class
